COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C  THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
C00013 ENDMK
C⊗;
C  THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
C  AT STANFORD UNIVERSITY.  IT MAY NOT BE COPIED OR ALTERED IN ANY
C  WAY WITHOUT WRITTEN PERMISSION OF THE AUTHOR.


C  7/74 **********  SCORE  **********  LELAND SMITH, SEP.1969

C   THIS PROGRAM WRITES NOTE LISTS FOR THE PDP10 SOUND 
C   GENERATION PROGRAM.
C   IF # OF INSTS IS CHANGED, ALSO CHANGE # IN 'INFO'('HELP') FORMAT.
C   LOAD 'S1' WITH S2,S3,SCANR AND SPRINT 
C   (AND QUAD AND QUADO WHEN THEY ARE READY) AND
C   IF DESIRED, A SUBROUTINE WITH THE FOLLOWING HEADING:
C	SUBROUTINE SUBR
C	COMMON /P/P(1) /PL/PL(1) /INS/ INST(27),BG(60)
C	COMMON INUM,IPAR,CNT(27),BT,IREST,DF,DUR(27)
C   INUM=INST#  IPAR=PARAM#  
C   BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
C   IF IREST IS <0, THAT NOTE WILL BE A REST.  
C   INST=INST. NAME,  BG=INSTS' BEGIN TIMES.
C   NOTE #S IN SUBROUTINE: (1-108)  C4=49  FS4=55  B4=60  C5=61  ETC.
C   F0=200  F99=299 (LIMIT IS F0-F99!)  'R'(REST)=199

	COMMON /Q/ BNW(200),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT,
	1 LN,ITYP,TPALN(4),JED /SAM/ISAM,ITRUNC
CC 7/74 COLGATE  COMMON/TYP/ IS FOR COLTTY ROUT.
C  SEE LABEL 1774 AND BELOW RE. BUFFER LIMIT.
	COMMON/VV/LIMIT,V(16000) /A/ROFF(27),NP(27),
	1 RDEV(27),XT(27),OTH(20,16),P1(27),JFM(4),IFM(80)
	1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
	DIMENSION LIST(78),JNP(80)
C   WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY 
C   40 LIT CHARS + 99 PARAMS PER INST.
C   60 BG TIMES AVAILABLE.  FOR INSTS AND INSERTS AND EDITS.

	COMMON /PCIP/ PCH(27,102),IPT(27,101)
	COMMON/P/P(99) /PL/PL(117) /COPY/NUMP,COPY(99) /COPYL/COPYL(99)
C NUMP=99 = TOTAL NUMBER OF PARAMETERS NOW AVAILABLE. RAN.DEV. IS NUMP+1
	COMMON J,L,CNT(27),BT,MK,DF,DUR(27)
	1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
	1 ,INP(145),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
	COMMON/B/MOT,PR,T5,NINS,I,RA,KZY,NWX,INONLY,MX,
	1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
	1 ZZ,CHN,YY 
	1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
	1  /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
	1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
	1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
C  /C/=26
	EQUIVALENCE (LIST,IFM(3)),(JNP,INP)
	DATA KZY/27/,ISEMI/';'/,IQT/'"'/,LIMIT/16000/,NUMP/99/
	1, JFM(3)/','/
C  IAA=A  ID=D  IE=E  IF=F  IEN=N  IPP=P  ISS=S  ITT=T
	DATA IBLA/' '/,IXX/'X'/
	1 ,ISCA/'C','P','D','O','E','F','PLAY;','G','S','A','T','B'/
	1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
	TYPE 8003
8003	FORMAT(' FOR "MUS10" OUTPUT, FIRST TYPE "MUS10"'/)
C	1' NOW 99 PARAMETERS MAY BE USED.'/
C	1'     FOR RANDOM RESTS USE RR '/
C	1'         FOR RANDOM P1 DEVIATION USE RD'/)
	ISAM=-1
	ITRUNC=0
	LPAR=0
	IPRN=0
	QX=0.
	MOT=0
	RETRO=-1.
	INVRT=-1
	ICON=-1
	LCNT=1
	PARENS=0
      JZ=1  
	CALL RNDINT
C  INIT RAND NUM GENERATOR.
CC    PR=0  
	IAMP=0
C  IAMP IS 'BLANK LINE'FLAG ON PP1-3.
      T5=0  
      NINS=0
	K=0
	IDALL=-1
	QTS=-1.
      KB=0  
      NWZ=1
	BNW(1)=0
	I=1
      KL=0  
CC    TP=0  
      RA=0  
      CHN=0 
	DO 127 K=1,77,3
127	LIST(K)=0
C  INITIALIZES MOTIVIC LIST FOR ERROR FINDING ROUTINE.
	NWX=0
	BY=-1
      DO 1128 K=1,KZY     
	INVIS(K)=0
	INST(K)=0
	CNT(K)=0
	RDEV(K)=0
C  RDEV IS FOR RAND DEVIATIONS AT RUN TIME
	NP(K)=0
	IQ(K)=0
C   IQ IS FOR RESTART FLAG
	IPT(K,1)=0
      DO 1128 L=1,NUMP+2
1128   PCH(K,L)=0 

	ITYP=-1
C   TYPE 'FILE NAME', TEMPO FACTOR(0=1), AMPL.FACT(0=1),
C   SECONDS TO BE OMITTED, DUR AT CUTOFF.
	JED=-1
2112	TYPE 8002
1112	ACCEPT 77732,JNP
	JFM(4)='5F)'
	JFM(1)='   (A'
C   FOR FREE 'A' FORMAT
	CALL FMT(JFM,JNP,MLX)
	REREAD JFM,K,TF,AMPFAC,OP1,DURX
	CALL LO2UP(K)
C  JFM IS THE CURRENT FORMAT STATEMENT
	IF(K.NE.'TRUNC')GO TO 2999
	ITRUNC=-1
	TYPE 3999
	GO TO 2112
C TRUNCATION SWITCH CONSIDERS PARAMETERS TO BE LOCAL FOR EACH INST.
3999	FORMAT(' TRUNCATION SWITCH SET (PARAMS ARE LOCAL ONLY)')
2999	IF(K.NE.'MUS10')GO TO 999
	ISAM=0 
	TYPE 1999
	GO TO 2112
C SAMSWITCH ALLOWS FOR OVERLAPS OF INSTRUMENTS AND OMITS 'PLAY' AT TOP.
1999	FORMAT(' MUS10 SWITCH HAS BEEN SET.')
999	IF(K.NE.'EDIT')GO TO 3112
	JED=0
	GO TO 2112
C  'E(DIT)' GOES TO EDIT MODE
3112	IF(TF.EQ.0)TF=1.
	IF(AMPFAC.EQ.0)AMPFAC=1.
21122	IF(K.NE.'TYPE')GO TO 128
	ITYP=0
	DATA FINM/30H(' TYPE OUTPUT FILE NAME'/)   /
	IFLNM='TYPED'
CC	IFLNM='FOR21'
CC	REWIND 21
	CALL OFILE(21,IFLNM)
	GO TO 3127
8001	FORMAT(A5,5F)
77732	FORMAT(80A1)
300	FORMAT(I,3F)
128	IF(K.EQ.'INFO')GO TO 1280
	IF(K.EQ.'HELP')GO TO 1280
	IF(K.NE.'?')GO TO 3128
1280	TYPE 8002
	TYPE 1113
	TYPE 118
	TYPE 1114
	TYPE 8002
	GO TO 1112
118	FORMAT(' TO DSK=1,11   TTY=2,22   BOTH=0,33   LPT=4'/)
C118	FORMAT(' TO DSK=1, TTY=2, BOTH=0, LPT=22, PROOF=3, DEBUG=4'/)
CC***  TEMPORARY ***8002	FORMAT(' TYPE FILE NAME'/)
8002	FORMAT(' TYPE FILE NAME--  '$)
1113	FORMAT(' YOU MAY TYPE:  NAME  TEMPO-FAC  AMPFAC  OMIT"  DUR"'//)
1114	FORMAT('    FOR THE ABOVE YOU MAY TYPE UP TO 3 NUMBERS: N1 N2 N3'//
	1' N1 = 1 WRITES DATA ON DSK,  =2 WRITES ONLY ON SCREEN,'/
	1'    = 0 WRITES ON DSK AND SCREEN.'/
	1'    = 11,22,33 ARE THE SAME AS 1,2,0 BUT INPUT LIST IS NOT
	1 WRITTEN ON SCREEN.'/
	1/' N2 = RAN NUM INITIALIZATION.       N3 = DO ONLY INST. #N'/
	1/' ALSO FOR N1:  N1=5(OR 55)=DURS ONLY (FOR PROOFING)
	1, =6(OR 66)=DEBUG V ARRAY'//
	1 3X' UP TO 99 PARAMETERS AND 27 INSTRUMENTS ARE AVAILABLE'/)

3128	IF(K.EQ.IBLA)K=IFLNM
	CALL IFILE(23,K)
	IFLNM=K
	READ(23,300)LN,IXIN
C  CHECK FOR LINE NUMBERS ONLY.
	REREAD 8001,K
	IF(K.NE.'COMME')GO TO 3000
3001	READ(23,77732)JNP
	IF(JNP(3).NE.ISEMI)GO TO 3001
	GO TO 3127
C  TO READ HEADER OF 'ET' FILES
3000	REWIND 23
	CALL IFILE(23,IFLNM)

CC3127	ISLAC=(IFLNM.AND."003777777777).OR."550000000000
C MAGIC TO CHANGE LFT. LETTER TO Z(INP. ABCDE BECOMES ZBCDE.DAT)
3127	ISLAC=IFLNM
C  NOW USES MY FORNAM SUBROUTINE TO  PUT EXTENSION .SCR ON OUTPUT
5127	TYPE 118
	IF(DURX.EQ.0)DURX=19999.
	IXIN=1
	INONLY=-1
	SOS=-1.
	ACCEPT 300,MX,X,Z
	IF(MX.NE.99)GO TO 6127
	TYPE FINM
	ACCEPT 8001,ISLAC
	CALL LO2UP(ISLAC)
	GO TO 5127
6127	IF(Z.NE.0)INONLY=Z
	IF(X.NE.0)IXIN=X
	IF(MX.LT.10)GO TO 8127
	MX=MX/10
	IF(MX.EQ.3)MX=0
	SOS=0
C MX=10,11,ETC.,22,ETC.(INSTEAD OF 1,2) SUPPRESSES INPUT LISTING.
8127	JOUT=5
C  5=OUTPUT TO TTY
CC	JOUT=3 DIRECT TO LPT AT COLGATE 6/74
	MZ=0
	GO TO(110,210,310,410,510,610)MX
C 0=DSK,TTY  1=DSK  2=TTY  3=0  4=LPT  5=TTY  6=TTY
310	MZ=-1
110	CALL FORNAM(ISLAC,'SCR')
	MX=-1  
	CALL READIT
410	JOUT=22
210	MZ=-1
510	CALL READIT
610	MZ=-6
	CALL READIT
      END

	SUBROUTINE LO2UP(J)
C CONVERTS ALL LOWER CASE IN WORD J TO UPPER CASE.
	J=J.AND..NOT.((J/2).AND."201004020100)
	END